Power CD/Power CD ATARI-Rechner Lieben.iso/DEMOS/HM2_DEMO/BSP/ROBOTS.M

Text File | 1992-07-09 | 6.5 KB | 315 lines

MODULE Robots;

  IMPORT InOut, GEMDOS, XBIOS;
  FROM InOut IMPORT
     Write, Read, WriteString, WriteLn;

  CONST
     cIch = '@';
     cRob = '=';
     cBlech = '#';
     cMampf = '*';
     cLeer = ' ';
     cESC = 33C;

     (* Scancodes                                     *)
     Num0 = 112;     (* Teleport                 *)
     Num1 = 109;     (* links unten             *)
     Num2 = 110;     (* unten                     *)
     Num3 = 111;     (* rechts unten             *)
     Num4 = 106;     (* links                     *)
     Num5 = 107;     (* warten                     *)
     Num6 = 108;     (* rechts                     *)
     Num7 = 103;     (* links oben              *)
     Num8 = 104;     (* oben                      *)
     Num9 = 105;     (* rechts oben             *)
     NumMal = 102;  (* bis zum Ende warten  *)
     Undo = 97;      (* Ende                      *)

  TYPE
     tRoboter = RECORD
        lebend: BOOLEAN;
        X, Y: SHORTINT;
    END;

  CONST
     cMaxRoboter = 300;
     cMaxZeile = 23;
     cMaxSpalte = 79;

  VAR
     RoboterListe: ARRAY[1..cMaxRoboter] OF tRoboter;
     Besetzt: ARRAY[0..cMaxSpalte],[0..cMaxZeile] OF CHAR;
     RoboterZahl: SHORTINT;
     LebendeRoboter: SHORTINT;
     TeleportsProEbene: SHORTINT;
     FreieTeleports: SHORTINT;
     Ebene: SHORTINT;
     MeinX: SHORTINT;
     MeinY: SHORTINT;
     Gegessen: BOOLEAN;
     Warten: BOOLEAN;


  PROCEDURE RoboterSpiel;
     VAR
        x: CHAR;
  BEGIN
     REPEAT
        FreieTeleports := 0;
        TeleportsProEbene := 1;
        Ebene := 0;
        RoboterZahl := 0;
        Gegessen := FALSE;
        REPEAT
          Warten := FALSE;
          FreieTeleports := FreieTeleports + TeleportsProEbene;
          INC (RoboterZahl, 10);
          LebendeRoboter := RoboterZahl;
          INC (TeleportsProEbene);
          INC (Ebene);
          ZeichneBildSchirm;
          SetzeRoboter;
          FreierPlatz (cIch, MeinX, MeinY);
          Setze (cIch, MeinX, MeinY);
          LOOP
             SpielStand;
             IF LebendeRoboter = 0 THEN EXIT END;
             NaechsteBewegung;
             RoboterBewegung;
             IF Gegessen THEN EXIT END;
          END;
        UNTIL Gegessen;
        Setze (' ', 0, 24);
        WriteString ("Noch ein Spiel (j/n)?         ");
        InOut.Read (x);
     UNTIL CAP (x) = 'N'
  END RoboterSpiel;


  PROCEDURE ZeichneBildSchirm;
     VAR
        i, j: SHORTCARD;
  BEGIN
     (* Bildschirm loeschen *)
     InOut.Write (cESC);
     InOut.Write ('E');
     (* Karte Loeschen *)
     FOR i := 0 TO cMaxSpalte DO
        FOR j := 0 TO cMaxZeile DO
          Besetzt [i][j] := ' ';
        END;
     END;
  END ZeichneBildSchirm;


  PROCEDURE SetzeRoboter;
     VAR
        i, x, y: SHORTINT;
  BEGIN
     FOR i := 1 TO RoboterZahl DO
        FreierPlatz (cRob, x, y);
        WITH RoboterListe [i] DO
          X := x;
          Y := y;
          lebend := TRUE;
        END;
        Setze (cRob, x, y);
     END;
  END SetzeRoboter;


  PROCEDURE NaechsteBewegung;
     VAR
        c: SHORTCARD;
        con: GEMDOS.tCconin;
        x, y: SHORTINT;
        Bewegt, Weiter: BOOLEAN;
  BEGIN
     Bewegt := FALSE;
     REPEAT
        REPEAT
          Weiter := TRUE;
          IF Warten THEN
             c := Num5;
          ELSE
             con := GEMDOS.Crawcin ();
             c := ORD (con.scan);
          END;
          CASE c OF
             |Num7:
                x := -1; y := -1;
             |Num9:
                x :=    1; y := -1;
             |Num1:
                x := -1; y :=    1;
             |Num3:
                x :=    1; y :=    1;
             |Num4:
                x := -1; y :=    0;
             |Num2:
                x :=    0; y :=    1;
             |Num8:
                x :=    0; y := -1;
             |Num6:
                x :=    1; y :=    0;
             |Num5:
                x :=    0; y :=    0;
             |Undo:
                GEMDOS.Pterm0;
             |NumMal:
                x := 0; y := 0; Warten := TRUE;
             |Num0:
                Weiter := FALSE;
                Setze (cLeer, MeinX, MeinY);
                IF FreieTeleports > 0 THEN
                  DEC (FreieTeleports);
                  REPEAT
                  UNTIL NeuerPlatz (MeinX, MeinY) = cLeer;
                  Setze (cIch, MeinX, MeinY);
                ELSE
                  IF NeuerPlatz (MeinX, MeinY) = cLeer THEN
                     Setze (cIch, MeinX, MeinY);
                  ELSE
                     Setze (cMampf, MeinX, MeinY);
                     Gegessen := TRUE;
                     Weiter := TRUE;
                  END;
                END;
          ELSE
          END;
        UNTIL Weiter;
        IF ((MeinX + x) < 0) OR ((MeinX + x) > cMaxSpalte) OR
            ((MeinY + y) < 0) OR ((MeinY + y) > cMaxZeile) THEN
          InOut.Write (7C);
        ELSE
          Setze (cLeer, MeinX, MeinY);
          Bewegt := TRUE;
        END;
     UNTIL Bewegt;
     MeinX := MeinX + x;
     MeinY := MeinY + y;
     CASE Besetzt [MeinX, MeinY] OF
        |cRob:
          Setze (cMampf, MeinX, MeinY);
          Gegessen := TRUE;
        |cBlech:
          IF ((MeinX + x) >= 0) AND ((MeinX + x) <= cMaxSpalte) AND
              ((MeinY + y) >= 0) AND ((MeinY + y) <= cMaxZeile) AND
              (Besetzt [MeinX + x, MeinY + y] = cLeer) THEN
             Setze (cBlech, MeinX + x, MeinY + y);
             Setze (cIch, MeinX, MeinY);
          ELSE
             MeinX := MeinX - x;
             MeinY := MeinY - y;
             Setze (cIch, MeinX, MeinY);
          END;
        |cLeer:
          Setze (cIch, MeinX, MeinY);
     END;
  END NaechsteBewegung;


  PROCEDURE RoboterBewegung;
     VAR
     i, j: SHORTINT;
  BEGIN
     FOR i := 1 TO RoboterZahl DO
        WITH RoboterListe [i] DO
          IF lebend THEN
             Setze (' ', X, Y);
             IF X > MeinX THEN
                DEC (X);
             ELSIF X < MeinX THEN
                INC (X);
             END;
             IF Y > MeinY THEN
                DEC (Y);
             ELSIF Y < MeinY THEN
                INC (Y);
             END;
          END;
        END;
     END;
     FOR i := 1 TO RoboterZahl DO
        WITH RoboterListe [i] DO
          IF lebend THEN
             CASE Besetzt [X, Y] OF
                |cLeer:
                  Setze (cRob, X, Y);
                |cRob:
                  Setze (cBlech, X, Y);
                  lebend := FALSE;
                  DEC (LebendeRoboter);
                  FOR j := 1 TO RoboterZahl DO
                     IF (X = RoboterListe [j].X) AND
                         (Y = RoboterListe [j].Y) AND
                        RoboterListe [j].lebend THEN
                        RoboterListe [j].lebend := FALSE;
                        DEC (LebendeRoboter);
                     END;
                  END;
                |cBlech:
                  lebend := FALSE;
                  DEC (LebendeRoboter);
                |cIch:
                  Setze (cMampf, X, Y);
                  Gegessen := TRUE;
             END;
          END;
        END;
     END;
  END RoboterBewegung;


  PROCEDURE FreierPlatz (z: CHAR; VAR x, y: SHORTINT);
  BEGIN
     REPEAT
     UNTIL NeuerPlatz (x, y) = ' ';
     Besetzt [x][y] := z;
  END FreierPlatz;


  PROCEDURE NeuerPlatz (VAR x, y: SHORTINT): CHAR;
  BEGIN
     x := Random (cMaxSpalte+1);
     y := Random (cMaxZeile+1);
     RETURN Besetzt [x][y];
  END NeuerPlatz;


  PROCEDURE Setze (z: CHAR; x, y: SHORTCARD);
  BEGIN
     IF (x <= cMaxSpalte) AND (y <= cMaxZeile) THEN
         Besetzt [x, y] := z;
     END; (* IF *)
     InOut.Write (cESC);
     InOut.Write ('Y');
     InOut.Write (CHR (ORD (' ') + y));
     InOut.Write (CHR (ORD (' ') + x));
     InOut.Write (z);
  END Setze;


  PROCEDURE SpielStand;
  BEGIN
     Setze ('(', 0, 24);
     InOut.WriteCard (FreieTeleports, 0);
     InOut.WriteString (")  ");
     InOut.WriteCard (Ebene, 0);
     InOut.WriteString (". Ebene; ");
     InOut.WriteInt (LebendeRoboter, 0);
     InOut.WriteString (" Roboter        ");
  END SpielStand;


  PROCEDURE Random (n: LONGCARD): LONGCARD;
  BEGIN
     RETURN LONGCARD(XBIOS.Random ()) MOD n;
  END Random;


BEGIN
    RoboterSpiel;
END Robots.